home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / lisp / gzip.jl < prev    next >
Lisp/Scheme  |  1995-03-09  |  3KB  |  88 lines
  1. ;;;; gzip.jl -- Editing gzipped files
  2. ;;;  Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'gzip)
  21.  
  22. ;;; Simple hooks to read and write compressed (compress or gzip) files.
  23. ;;; Do `(require 'gzip)' to load and install it. Any files whose name
  24. ;;; ends in `.gz' or `.Z' will be (de-)compressed as necessary.
  25.  
  26. ;;; TO-DO:
  27. ;;; * Info should work with compressed files
  28. ;;; * able to specify what suffixes run what (de)compressors
  29.  
  30. ;; Uncompress FILE-NAME into the current buffer
  31. (defun gzip-uncompress (file-name)
  32.   (let
  33.       ((proc (make-process (current-buffer))))
  34.     (message (concat "Uncompressing `" file-name "'") t)
  35.     ;; gunzip can do .Z files as well
  36.     (unless (zerop (run-process proc nil "gunzip" "-c" file-name))
  37.       (signal 'file-error (list "Can't gunzip file" file-name)))))
  38.     
  39. ;; In the read-file-hook
  40. (defun gzip-read-file (file-name buffer)
  41.   (when (regexp-match "\\.(gz|Z)$" file-name)
  42.     ;; gzipped file, decompress it into the buffer
  43.     (let
  44.     ((old-pos (cursor-pos)))
  45.       (with-buffer buffer
  46.     (gzip-uncompress file-name)
  47.     (goto-char old-pos)
  48.     (unless mode-name
  49.       ;; so init-mode has a chance
  50.       (setq mode-name (regexp-expand "^(.*)\\.(gz|Z)$" file-name "\\1")))
  51.     (setq buffer-file-modtime (file-modtime file-name))
  52.     (set-buffer-file-name buffer file-name))
  53.       t)))
  54.  
  55. ;; In insert-file-hook
  56. (defun gzip-insert-file (file-name)
  57.   (when (regexp-match "\\.(gz|Z)$" file-name)
  58.     ;; compressed file
  59.     (gzip-uncompress file-name)))
  60.  
  61. ;; In write-file-hook
  62. (defun gzip-write-file (file-name buffer)
  63.   (when (regexp-match "\\.(gz|Z)$" file-name)
  64.     (let
  65.     ((modes (when (file-exists-p file-name) (file-modes file-name)))
  66.      (tmp-name (tmp-file-name))
  67.      (compressor (if (regexp-match "\\.Z$" file-name) "compress" "gzip"))
  68.      dst-file proc)
  69.       (backup-file file-name)
  70.       (when (and (write-buffer tmp-name buffer)
  71.          (setq dst-file (open file-name "wb")))
  72.     (unwind-protect
  73.         (progn
  74.           (setq proc (make-process dst-file))
  75.           (message (concat "Compressing `" file-name "'... ") t)
  76.           (when (/= (run-process proc nil compressor "-c" tmp-name) 0)
  77.         (signal 'file-error (list "Can't compress file"
  78.                       tmp-name compressor))))
  79.       (close dst-file)
  80.       (delete-file tmp-name))
  81.     (when modes
  82.       (set-file-modes file-name modes))
  83.     t))))
  84.  
  85. (add-hook 'read-file-hook 'gzip-read-file)
  86. (add-hook 'insert-file-hook 'gzip-insert-file)
  87. (add-hook 'write-file-hook 'gzip-write-file)
  88.